{$i-,s-,g+,r-}
{$ifndef modif}{$i modif.inc}{$endif}
Program Convert;
uses {$ifdef Windows}
     WinCrtx,WinDos,
     {$else}
      {$ifdef crtx}crtx,{$else}crt,{$endif}dos,
     {$endif}
     pictures,ToolsB;

var vystup,a:string;
    obr,fbr:Picture;
    ukObr:^Picture;
    i,j,oplanes:integer;
    MarkedTime:Longint;
    ForceGray,Scalling:Boolean;
    SeparType:char;
    PassLProc:PercentLineProc;
    PeeledPlane:shortint;


Function GetInterval:Longint; assembler;
asm
	MOV	AH,0
	INT	1Ah
	MOV	AX,DX
	MOV	DX,CX
end;

Function Numeric(const s:string):Boolean;
var i:byte;
begin
Numeric:=False;
for i:=1 to length(s) do
	if not(s[i] in ['-','+','0'..'9']) then exit;
Numeric:=True;
end;


Label 1,2,Finish;

const Title:array[0..16]of char='Convert image'#0;
const Verbosity:integer = 0;
const HeaderPrinted:integer = 0;

Procedure PrintHeader;
begin
  if((Verbosity>=0) and (HeaderPrinted<=0)) then
    begin
    writeln(#10#13'<<< CONVERT >>> Convert picture format (c)1996-2009 F&TSoft');
    HeaderPrinted:=1;
    end
end;

var result: boolean;
    OutputFormat: string;
begin
{$ifdef Windows}
ScreenSize.X:=62;
ScreenSize.Y:=10;
WindMax:=ScreenSize;
Move(Title,WindowTitle,Sizeof(Title));
{$endif}

 PassLProc.init;
 obr.init;
 fbr.init;
{$ifndef  Windows}
  DirectVideo:=False;
  nosound;
{$endif}
 vystup:='';
 OPlanes:=-1;
 Scalling:=True;
 ForceGray:=False;
 SeparType:=#0;
 PeeledPlane:=-1;
 if Paramcount=0 then
	begin
        PrintHeader;
1:	write('Enter name of input picture:');readln(a);
	if a='' then goto 1;
	assignpicture(obr,a);
2:	write('Enter name of output picture:');readln(a);
	vystup:=a;
	if a='' then goto 2;
	end;

 i:=0;
 while i<paramcount do
	begin
	inc(i);
	a:=paramStr(i);
	if((a[2]='?')or(a[1]='?'))or((UpCases(a)='/HELP')or(UpCases(a)='-HELP')) then
		begin
		PrintHeader;
		writeln(#10#13'CONVERT file_in file_out [output_planes] [/NoScale] [/Gray] [/PeelPlane n]'#10#13+
			      'Supported input file formats are ART,BMP,CUT,FTG,GIF,HRZ,ICO,'+
			      {$ifdef jpg}'JPG,'+{$endif}
			      'MAT,OKO,PBM,PCX,PS,RAS,TIF,TGA,TXT,WPG'#10#13+
			      '/NoScale      - means truncating image data'#10#13+
			      '/Gray         - discards all color informations'#10#13,
			      '/SEPARATE[R|G|B] - remove one channel from true color images'#10#13+
			      '/PeelPlane n  - cut only plane with number n'#10#13+
			      'output_planes - it is count of output planes'#10#13);
		{$ifdef Windows}InactiveWinCrt;{$endif}
		exit;
		end;

	if UpCases(a)='/NOSCALE' then
		begin
		Scalling:=false;
		continue;
		end;
	if UpCases(a)='/FORMAT' then
		begin
		inc(i);
		OutputFormat := ParamStr(i);
		continue;
		end;
	if UpCases(a)='/GRAY' then
		begin
		ForceGray:=True;
		continue;
		end;
	if UpCases(a)='/PEELPLANE' then
		begin
		inc(i);
		a:=ParamStr(i);
		j:=-1;
		if Numeric(a) then
			begin
			val(a,PeeledPlane,j);
			end;
		if (j<>0)or(PeeledPlane<0) then
			begin
			PrintHeader;
			writeln('Error:Incorrect number of cutted plane ',a);
			{$ifdef Windows}InactiveWinCrt;{$endif}
			exit;
			end;
		continue;
		end;

	if UpCases(a)='/S' then
		begin
		Verbosity:=-1;
		continue;
		end;

	if UpCases(copy(a,1,length(a)-1))='/SEPARATE' then
		begin
		a:=copy(a,length(a),length(a));
		if ((a='R')or(a='G'))or(a='B') then SeparType:=UpCase(a[1]);
		continue;
		end;

	if Numeric(a) then
		      begin
		      val(a,OPlanes,j);
		      if (j<>0)or not(Oplanes in [1,2,4,8,16]) then
				   begin
				   PrintHeader;
				   writeln('Error:Incorrect number of planes ',a);
				   {$ifdef Windows}InactiveWinCrt;{$endif}
				   exit;
				   end;
		      continue;
		      end;

	if obr.filename=nil then assignpicture(obr,a)
			    else vystup:=a;
	end;

 PrintHeader;
 if obr.filename=nil then
	begin
	writeln('Error:Unknown filename');
	{$ifdef Windows}InactiveWinCrt;{$endif}
	exit;
	end;
 if Vystup='' then
	begin
	writeln('Error:Unknown output filename');
	{$ifdef Windows}InactiveWinCrt;{$endif}
	exit;
	end;

 MarkedTime:=GetInterval;

 if Verbosity>0 then
  begin;write(#13' Loading ');ClrEol;end;

 if Verbosity>0 then
   loadpicture(obr,'',@PassLProc)	{} {  loadpicture(fbr);{}
 else
   loadpicture(obr,'',nil);

 if obr.data=nil then
	begin
	writeln(#10#13'Cannot find input picture:''',obr.filename^,'''');
	{$ifdef Windows}InactiveWinCrt;{$endif}
	goto Finish;
	end;
 if ForceGray and (obr.palette<>nil) then
	begin
	write(#13' Making Gray ');
	if Scalling then ReMapPalAsGray(obr);
	ErasePalette(obr.Palette);
	end;

 if separType<>#0 then
	begin
        if Verbosity>0 then
	  begin;write(#13' Separating:',SeparType,' ');ClrEol;end;
        if Verbosity>0 then
          begin
	  Separate(obr,fbr,SeparType,@PassLProc);
	  movePicture(fbr,Obr,@PassLProc);
	  end
        else
	  begin
	  Separate(obr,fbr,SeparType,nil);
	  movePicture(fbr,Obr,nil);
          end;
	fbr.Erase;
	end;

 if PeeledPlane>=0 then
	begin
        if Verbosity>0 then
	  begin;write(#13' Peeling plane:',PeeledPlane,' ');ClrEol;end;
	PeelPlane(obr,fbr,PeeledPlane);
        if Verbosity>0 then
	  movePicture(fbr,Obr,@PassLProc)
	else
          movePicture(fbr,Obr,nil);
	fbr.Erase;
	end;


 UkObr:=@Obr;
 if Oplanes<>-1 then
	begin
        if Verbosity>0 then
	  begin;write(#13' Converting ');ClrEol;end;
	Fbr.planes:=Oplanes;
        if Verbosity>0 then
	  pictures.Convert(Obr,Fbr,Oplanes,Fbr.Typ,Scalling,@PassLProc)
	else
          pictures.Convert(Obr,Fbr,Oplanes,Fbr.Typ,Scalling,nil);
	UkObr:=@Fbr;
	Obr.Erase;
	end;

 if Verbosity>0 then begin;write(#13' Saving ');ClrEol;end;

 if Verbosity>0 then
   result:=savepicture(UkObr^,vystup,@PassLProc)
 else
   result:=savepicture(UkObr^,vystup,nil);

 if not(result) then
	begin
	writeln(#10#13'Cannot save Output picture:''',UkObr^.filename^,'''');
{$ifdef Windows}InactiveWinCrt;{$endif}
	goto Finish;
	end;

 if Verbosity>0 then
   begin;writeln(#13' OK     ',abs(MarkedTime-GetInterval)/18.2:2:2,'s');ClrEol;end;

Finish:
 while PeepError<>0 do writeln('Error: ',GetErrorString(ReadError));
 obr.Done;
 fbr.Done;

{halt(0);}
end.
